home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / tests / open.test < prev    next >
Encoding:
Text File  |  1993-11-03  |  21.2 KB  |  662 lines  |  [TEXT/MPS ]

  1. # Commands covered:  open, close, gets, puts, read, seek, tell, eof, flush
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/open.test,v 1.18 93/06/03 10:30:24 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. catch {rm -f {test1 test2 test3}}
  32. set fd [open test1 "w"]
  33. puts $fd "Two lines: this one\nand this one"
  34. close $fd
  35. set fd [open test2 "w"]
  36. puts $fd "line1\nline2\nline3\nline4\nline5"
  37. close $fd
  38.  
  39. test open-1.1 {open command (files only)} {
  40.     set f [open test1]
  41.     set x [gets $f]
  42.     close $f
  43.     set x
  44. } {Two lines: this one}
  45. test open-1.2 {open command (files only)} {
  46.     set f [open test1]
  47.     set f2 [open test2]
  48.     set f3 [open test1]
  49.     set f4 [open test1]
  50.     set x [list [gets $f] [gets $f2] [gets $f3] [gets $f4] \
  51.         [gets $f] [gets $f2]]
  52.     close $f
  53.     close $f2
  54.     close $f3
  55.     close $f4
  56.     set x
  57. } {{Two lines: this one} line1 {Two lines: this one} {Two lines: this one} {and this one} line2}
  58. test open-1.3 {open command (files only)} {
  59.     set f [open test3 w]
  60.     puts $f xyz
  61.     close $f
  62.     cat test3
  63. } "xyz"
  64. test open-1.4 {open command (files only)} {
  65.     set f [open test3 w]
  66.     puts $f xyz
  67.     close $f
  68.     set f [open test3 a]
  69.     puts $f 123
  70.     close $f
  71.     cat test3
  72. } "xyz\n123"
  73. test open-1.5 {open command (files only)} {
  74.     set f [open test3 w]
  75.     puts $f xyz\n123
  76.     close $f
  77.     set f [open test3 r+]
  78.     set x [gets $f]
  79.     seek $f 0 current
  80.     puts $f 456
  81.     close $f
  82.     list $x [cat test3]
  83. } "xyz {xyz
  84. 456}"
  85. test open-1.6 {open command (files only)} {
  86.     set f [open test3 w]
  87.     puts $f xyz\n123
  88.     close $f
  89.     set f [open test3 w+]
  90.     puts $f xyzzy
  91.     seek $f 2
  92.     set x [gets $f]
  93.     close $f
  94.     list $x [cat test3]
  95. } "zzy xyzzy"
  96. test open-1.7 {open command (files only)} {
  97.     set f [open test3 w]
  98.     puts $f xyz\n123
  99.     close $f
  100.     set f [open test3 a+]
  101.     puts $f xyzzy
  102.     flush $f
  103.     set x [tell $f]
  104.     seek $f -4 cur
  105.     set y [gets $f]
  106.     close $f
  107.     list $x [cat test3] $y
  108. } {14 {xyz
  109. 123
  110. xyzzy} zzy}
  111.  
  112. test open-2.1 {errors in open command} {
  113.     list [catch {open} msg] $msg
  114. } {1 {wrong # args: should be "open filename ?access? ?permissions?"}}
  115. test open-2.2 {errors in open command} {
  116.     list [catch {open a b c d} msg] $msg
  117. } {1 {wrong # args: should be "open filename ?access? ?permissions?"}}
  118. test open-2.3 {errors in open command} {
  119.     list [catch {open test1 x} msg] $msg
  120. } {1 {illegal access mode "x"}}
  121. test open-2.4 {errors in open command} {
  122.     list [catch {open test1 rw} msg] $msg
  123. } {1 {illegal access mode "rw"}}
  124. test open-2.5 {errors in open command} {
  125.     list [catch {open test1 r+1} msg] $msg
  126. } {1 {illegal access mode "r+1"}}
  127. test open-2.6 {errors in open command} {
  128.     string tolower [list [catch {open _non_existent_} msg] $msg $errorCode]
  129. } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
  130.  
  131. if {![file exists ~:_test_] && [file writable ~]} {
  132.     test open-3.1 {tilde substitution in open} {
  133.     set f [open ~:_test_ w]
  134.     puts $f "Some text"
  135.     close $f
  136.     set x [file exists $env(HOME):_test_]
  137.     catch {rm -f $env(HOME):_test_}
  138.     set x
  139.     } 1
  140. }
  141. test open-3.2 {tilde substitution in open} {
  142.     set home $env(HOME)
  143.     unset env(HOME)
  144.     set x [list [catch {open ~:foo} msg] $msg]
  145.     set env(HOME) $home
  146.     set x
  147. } {1 {couldn't find HOME environment variable to expand "~:foo"}}
  148.  
  149. test open-4.1 {file id parsing errors} {
  150.     list [catch {eof gorp} msg] $msg $errorCode
  151. } {1 {bad file identifier "gorp"} NONE}
  152. test open-4.2 {file id parsing errors} {
  153.     list [catch {eof filex} msg] $msg
  154. } {1 {bad file identifier "filex"}}
  155. test open-4.3 {file id parsing errors} {
  156.     list [catch {eof file12a} msg] $msg
  157. } {1 {bad file identifier "file12a"}}
  158. test open-4.4 {file id parsing errors} {
  159.     list [catch {eof file123} msg] $msg
  160. } {1 {file "file123" isn't open}}
  161. test open-4.5 {file id parsing errors} {
  162.     list [catch {eof file1} msg] $msg
  163. } {0 0}
  164. test open-4.5 {file id parsing errors} {
  165.     list [catch {eof stdin} msg] $msg
  166. } {0 0}
  167. test open-4.6 {file id parsing errors} {
  168.     list [catch {eof stdout} msg] $msg
  169. } {0 0}
  170. test open-4.7 {file id parsing errors} {
  171.     list [catch {eof stderr} msg] $msg
  172. } {0 0}
  173. test open-4.8 {file id parsing errors} {
  174.     list [catch {eof stderr1} msg] $msg
  175. } {1 {bad file identifier "stderr1"}}
  176. set f [open test1]
  177. close $f
  178. set expect "1 {file \"$f\" isn't open}"
  179. test open-4.9 {file id parsing errors} {
  180.     list [catch {eof $f} msg] $msg
  181. } $expect
  182.  
  183. test open-5.1 {close command (files only)} {
  184.     list [catch {close} msg] $msg $errorCode
  185. } {1 {wrong # args: should be "close fileId"} NONE}
  186. test open-5.2 {close command (files only)} {
  187.     list [catch {close a b} msg] $msg $errorCode
  188. } {1 {wrong # args: should be "close fileId"} NONE}
  189. test open-5.3 {close command (files only)} {
  190.     list [catch {close gorp} msg] $msg $errorCode
  191. } {1 {bad file identifier "gorp"} NONE}
  192. test open-5.4 {close command (files only)} {
  193.     list [catch {close file8} msg] \
  194.         [string range $msg [string first {" } $msg] end] $errorCode
  195. } {1 {" isn't open} NONE}
  196.  
  197. test open-6.1 {puts command} {
  198.     list [catch {puts} msg] $msg $errorCode
  199. } {1 {wrong # args: should be "puts" ?-nonewline? ?fileId? string} NONE}
  200. test open-6.2 {puts command} {
  201.     list [catch {puts a b c d} msg] $msg $errorCode
  202. } {1 {wrong # args: should be "puts" ?-nonewline? ?fileId? string} NONE}
  203. test open-6.3 {puts command} {
  204.     list [catch {puts a b nonewlinx} msg] $msg $errorCode
  205. } {1 {bad argument "nonewlinx": should be "nonewline"} NONE}
  206. test open-6.4 {puts command} {
  207.     list [catch {puts gorp "New text"} msg] $msg $errorCode
  208. } {1 {bad file identifier "gorp"} NONE}
  209. test open-6.5 {puts command} {
  210.     set f [open test3]
  211.     set x [list [catch {puts $f "New text"} msg] \
  212.     [string range $msg [string first " " $msg] end] $errorCode]
  213.     close $f
  214.     set x
  215. } {1 { wasn't opened for writing} NONE}
  216. test open-6.6 {puts command} {
  217.     set f [open test3 w]
  218.     puts -nonewline $f "Text1"
  219.     puts -nonewline $f " Text 2"
  220.     puts $f " Text 3"
  221.     close $f
  222.     cat test3
  223. } {Text1 Text 2 Text 3}
  224.  
  225. test open-7.1 {gets command} {
  226.     list [catch {gets} msg] $msg $errorCode
  227. } {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
  228. test open-7.2 {gets command} {
  229.     list [catch {gets a b c} msg] $msg $errorCode
  230. } {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
  231. test open-7.3 {gets command} {
  232.     list [catch {gets a} msg] $msg $errorCode
  233. } {1 {bad file identifier "a"} NONE}
  234. test open-7.4 {gets command} {
  235.     set f [open test3 w]
  236.     set x [list [catch {gets $f} msg] \
  237.         [string range $msg [string first " " $msg] end] $errorCode]
  238.     close $f
  239.     set x
  240. } {1 { wasn't opened for reading} NONE}
  241. set f [open test3 w]
  242. puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  243. puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  244. puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  245. puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  246. puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  247. close $f
  248. test open-7.5 {gets command with long line} {
  249.     set f [open test3]
  250.     set x [gets $f]
  251.     close $f
  252.     set x
  253. } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
  254. test open-7.6 {gets command with long line} {
  255.     set f [open test3]
  256.     set x [gets $f y]
  257.     close $f
  258.     list $x $y
  259. } {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
  260. test open-7.7 {gets command and end of file} {
  261.     set f [open test3 w]
  262.     puts -nonewline $f "Test1\nTest2"
  263.     close $f
  264.     set f [open test3]
  265.     set x {}
  266.     set y {}
  267.     lappend x [gets $f y] $y
  268.     set y {}
  269.     lappend x [gets $f y] $y
  270.     set y {}
  271.     lappend x [gets $f y] $y
  272.     close $f
  273.     set x
  274. } {5 Test1 5 Test2 -1 {}}
  275. set f [open test3 w]
  276. puts $f "Line 1"
  277. puts $f "Line 2"
  278. close $f
  279. test open-7.8 {gets command and bad variable} {
  280.     catch {unset x}
  281.     set x 24
  282.     set f [open test3 r]
  283.     set result [list [catch {gets $f x(0)} msg] $msg]
  284.     close $f
  285.     set result
  286. } {1 {can't set "x(0)": variable isn't array}}
  287.  
  288. test open-8.1 {read command} {
  289.     list [catch {read} msg] $msg $errorCode
  290. } {1 {wrong # args: should be "read fileId ?numBytes?" or "read ?-nonewline? fileId"} NONE}
  291. test open-8.2 {read command} {
  292.     list [catch {read -nonewline} msg] $msg $errorCode
  293. } {1 {bad file identifier "-nonewline"} NONE}
  294. test open-8.3 {read command} {
  295.     list [catch {read a b c} msg] $msg $errorCode
  296. } {1 {wrong # args: should be "read fileId ?numBytes?" or "read ?-nonewline? fileId"} NONE}
  297. test open-8.4 {read command} {
  298.     list [catch {read -nonew file4} msg] $msg $errorCode
  299. } {1 {bad file identifier "-nonew"} NONE}
  300. test open-8.5 {read command} {
  301.     list [catch {read stdin foo} msg] $msg $errorCode
  302. } {1 {bad argument "foo": should be "nonewline"} NONE}
  303. test open-8.6 {read command} {
  304.     list [catch {read file10} msg] $msg $errorCode
  305. } {1 {file "file10" isn't open} NONE}
  306. test open-8.7 {read command} {
  307.     set f [open test3 w]
  308.     set x [list [catch {read $f} msg] \
  309.         [string range $msg [string first " " $msg] end] $errorCode]
  310.     close $f
  311.     set x
  312. } {1 { wasn't opened for reading} NONE}
  313. test open-8.8 {read command} {
  314.     set f [open test1]
  315.     set x [list [catch {read $f 12z} msg] $msg $errorCode]
  316.     close $f
  317.     set x
  318. } {1 {expected integer but got "12z"} NONE}
  319. test open-898 {read command} {
  320.     set f [open test1]
  321.     set x [list [catch {read $f z} msg] $msg $errorCode]
  322.     close $f
  323.     set x
  324. } {1 {bad argument "z": should be "nonewline"} NONE}
  325. test open-8.10 {read command} {
  326.     set f [open test1]
  327.     set x [list [read $f 1] [read $f 2] [read $f]]
  328.     close $f
  329.     set x
  330. } {T wo { lines: this one
  331. and this one
  332. }}
  333. test open-8.11 {read command, with over-large count} {
  334.     set f [open test1]
  335.     set x [read $f 100]
  336.     close $f
  337.     set x
  338. } {Two lines: this one
  339. and this one
  340. }
  341. test open-8.12 {read command, -nonewline switch} {
  342.     set f [open test1]
  343.     set x [read -nonewline $f]
  344.     close $f
  345.     set x
  346. } {Two lines: this one
  347. and this one}
  348.  
  349. test open-9.1 {seek command} {
  350.     list [catch {seek foo} msg] $msg $errorCode
  351. } {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
  352. test open-9.2 {seek command} {
  353.     list [catch {seek foo a b c} msg] $msg $errorCode
  354. } {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
  355. test open-9.3 {seek command} {
  356.     list [catch {seek foo 0} msg] $msg $errorCode
  357. } {1 {bad file identifier "foo"} NONE}
  358. test open-9.4 {seek command} {
  359.     set f [open test2]
  360.     set x [list [catch {seek $f xyz} msg] $msg $errorCode]
  361.     close $f
  362.     set x
  363. } {1 {expected integer but got "xyz"} NONE}
  364. test open-9.5 {seek command} {
  365.     set f [open test2]
  366.     set x [list [catch {seek $f 100 gorp} msg] $msg $errorCode]
  367.     close $f
  368.     set x
  369. } {1 {bad origin "gorp": should be start, current, or end} NONE}
  370. set f [open test3 w]
  371. puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  372. close $f
  373. test open-9.6 {seek command} {
  374.     set f [open test3]
  375.     set x [read $f 1]
  376.     seek $f 3
  377.     lappend x [read $f 1]
  378.     seek $f 0 start
  379.     lappend x [read $f 1]
  380.     seek $f 10 current
  381.     lappend x [read $f 1]
  382.     seek $f -2 end
  383.     lappend x [read $f 1]
  384.     seek $f 50 end
  385.     lappend x [read $f 1]
  386.     seek $f 1
  387.     lappend x [read $f 1]
  388.     close $f
  389.     set x
  390. } {a d a l Y {} b}
  391.  
  392. test open-10.1 {tell command} {
  393.     list [catch {tell} msg] $msg $errorCode
  394. } {1 {wrong # args: should be "tell fileId"} NONE}
  395. test open-10.2 {tell command} {
  396.     list [catch {tell a b} msg] $msg $errorCode
  397. } {1 {wrong # args: should be "tell fileId"} NONE}
  398. test open-10.3 {tell command} {
  399.     list [catch {tell a} msg] $msg $errorCode
  400. } {1 {bad file identifier "a"} NONE}
  401. test open-10.4 {tell command} {
  402.     set f [open test2]
  403.     set x [tell $f]
  404.     read $f 3
  405.     lappend x [tell $f]
  406.     seek $f 2
  407.     lappend x [tell $f]
  408.     seek $f 10 current
  409.     lappend x [tell $f]
  410.     seek $f 0 end
  411.     lappend x [tell $f]
  412.     close $f
  413.     set x
  414. } {0 3 2 12 30}
  415.  
  416. test open-11.1 {eof command} {
  417.     list [catch {eof} msg] $msg $errorCode
  418. } {1 {wrong # args: should be "eof fileId"} NONE}
  419. test open-11.2 {eof command} {
  420.     list [catch {eof a b} msg] $msg $errorCode
  421. } {1 {wrong # args: should be "eof fileId"} NONE}
  422. test open-11.3 {eof command} {
  423.     list [catch {eof file100} msg] $msg $errorCode
  424. } {1 {file "file100" isn't open} NONE}
  425. test open-11.4 {eof command} {
  426.     set f [open test1]
  427.     set x [eof $f]
  428.     lappend x [eof $f]
  429.     gets $f
  430.     lappend x [eof $f]
  431.     gets $f
  432.     lappend x [eof $f]
  433.     gets $f
  434.     lappend x [eof $f]
  435.     lappend x [eof $f]
  436.     close $f
  437.     set x
  438. } {0 0 0 0 1 1}
  439.  
  440. test open-12.1 {flush command} {
  441.     list [catch {flush} msg] $msg $errorCode
  442. } {1 {wrong # args: should be "flush fileId"} NONE}
  443. test open-12.2 {flush command} {
  444.     list [catch {flush a b} msg] $msg $errorCode
  445. } {1 {wrong # args: should be "flush fileId"} NONE}
  446. test open-12.3 {flush command} {
  447.     list [catch {flush a} msg] $msg $errorCode
  448. } {1 {bad file identifier "a"} NONE}
  449. test open-12.4 {flush command} {
  450.     set f [open test3]
  451.     set x [list [catch {flush $f} msg] \
  452.         [string range $msg [string first " " $msg] end] $errorCode]
  453.     close $f
  454.     set x
  455. } {1 { wasn't opened for writing} NONE}
  456. test open-12.5 {flush command} {
  457.     set f [open test3 w]
  458.     puts $f "Line 1"
  459.     puts $f "Line 2"
  460.     set f2 [open test3]
  461.     set x {}
  462.     lappend x [read -nonewline $f2]
  463.     close $f2
  464.     flush $f
  465.     set f2 [open test3]
  466.     lappend x [read -nonewline $f2]
  467.     close $f2
  468.     close $f
  469.     set x
  470. } {{} {Line 1
  471. Line 2}}
  472.  
  473. return ""
  474.  
  475. ###
  476. ### UNDONE PAST THIS POINT
  477. ###
  478.  
  479. test open-13.1 {I/O to command pipelines} {
  480.     list [catch {open "| cat < test1 > test3" w} msg] $msg $errorCode
  481. } {1 {can't write input to command: standard input was redirected} NONE}
  482. test open-13.2 {I/O to command pipelines} {
  483.     list [catch {open "| echo > test3" r} msg] $msg $errorCode
  484. } {1 {can't read output from command: standard output was redirected} NONE}
  485. test open-13.3 {I/O to command pipelines} {
  486.     list [catch {open "| echo > test3" r+} msg] $msg $errorCode
  487. } {1 {can't read output from command: standard output was redirected} NONE}
  488. test open-13.4 {writing to command pipelines} {
  489.     rm test3
  490.     set f [open "| cat | cat > test3" w]
  491.     puts $f "Line 1"
  492.     puts $f "Line 2"
  493.     close $f
  494.     cat test3
  495. } {Line 1
  496. Line 2}
  497. test open-13.5 {reading from command pipelines} {
  498.     set f [open "| cat test2" r]
  499.     set x [list [gets $f] [gets $f] [gets $f]]
  500.     close $f
  501.     set x
  502. } {line1 line2 line3}
  503. test open-13.6 {both reading and writing from/to command pipelines} {
  504.     set f [open "| cat -u" r+]
  505.     puts $f "Line1"
  506.     flush $f
  507.     set x [gets $f]
  508.     close $f
  509.     set x
  510. } {Line1}
  511. test open-13.7 {errors in command pipelines} {
  512.     set f [open "|gorp"]
  513.     list [catch {close $f} msg] $msg [lindex $errorCode 0] [lindex $errorCode 2]
  514. } {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
  515. test open-13.8 {errors in command pipelines} {
  516.     set f [open "|gorp" w]
  517.     sleep 1
  518.     puts $f output
  519.     set x [list [catch {flush $f} msg] [concat \
  520.         [string range $msg 0 [string first {"} $msg]] \
  521.         [string range $msg [string first : $msg] end]] $errorCode]
  522.     catch {close $f}
  523.     string tolower $x
  524. } {1 {error flushing " : broken pipe} {posix epipe {broken pipe}}}
  525. test open-13.9 {errors in command pipelines} {
  526.     set f [open "|gorp" w]
  527.     list [catch {close $f} msg] $msg \
  528.         [lindex $errorCode 0] [lindex $errorCode 2]
  529. } {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
  530. test open-13.10 {errors in command pipelines} {
  531.     set f [open "|gorp" w]
  532.     exec sleep 1
  533.     puts $f output
  534.     string tolower [list [catch {close $f} msg] [concat \
  535.         [string range $msg 0 [string first {"} $msg]] \
  536.         [string range $msg [string first : $msg] end]] \
  537.         [lindex $errorCode 0] [lindex $errorCode 2]]
  538. } {1 {error closing " : broken pipe
  539. couldn't find "gorp" to execute} childstatus 1}
  540.  
  541. test open-14.1 {POSIX open access modes: RDONLY} {
  542.     set f [open test1 RDONLY]
  543.     set x [list [gets $f] [catch {puts $f Test} msg] $msg]
  544.     close $f
  545.     set x
  546. } {{Two lines: this one} 1 {"file3" wasn't opened for writing}}
  547. test open-14.2 {POSIX open access modes: RDONLY} {
  548.     catch {rm -f test3}
  549.     string tolower [list [catch {open test3 RDONLY} msg] $msg]
  550. } {1 {couldn't open "test3": no such file or directory}}
  551. test open-14.3 {POSIX open access modes: WRONLY} {
  552.     catch {rm -f test3}
  553.     string tolower [list [catch {open test3 WRONLY} msg] $msg]
  554. } {1 {couldn't open "test3": no such file or directory}}
  555. test open-14.4 {POSIX open access modes: WRONLY} {
  556.     exec echo xyzzy > test3
  557.     set f [open test3 WRONLY]
  558.     puts -nonewline $f "ab"
  559.     seek $f 0 current
  560.     set x [list [catch {gets $f} msg] $msg]
  561.     close $f
  562.     lappend x [exec cat test3]
  563. } {1 {"file3" wasn't opened for reading} abzzy}
  564. test open-14.5 {POSIX open access modes: RDWR} {
  565.     catch {exec rm -f test3}
  566.     string tolower [list [catch {open test3 RDWR} msg] $msg]
  567. } {1 {couldn't open "test3": no such file or directory}}
  568. test open-14.6 {POSIX open access modes: RDWR} {
  569.     exec echo xyzzy > test3
  570.     set f [open test3 RDWR]
  571.     puts -nonewline $f "ab"
  572.     seek $f 0 current
  573.     set x [gets $f]
  574.     close $f
  575.     lappend x [exec cat test3]
  576. } {zzy abzzy}
  577. test open-14.7 {POSIX open access modes: CREAT} {
  578.     catch {exec rm -f test3}
  579.     set f [open test3 {WRONLY CREAT} 0600]
  580.     file stat test3 stats
  581.     set x [format "0%o" [expr $stats(mode)&0777]]
  582.     puts $f "line 1"
  583.     close $f
  584.     lappend x [exec cat test3]
  585. } {0600 {line 1}}
  586. if $atBerkeley {
  587.     test open-14.8 {POSIX open access modes: CREAT} {
  588.     catch {exec rm -f test3}
  589.     set f [open test3 {WRONLY CREAT}]
  590.     close $f
  591.     file stat test3 stats
  592.     format "0%o" [expr $stats(mode)&0777]
  593.     } 0664
  594. }
  595. test open-14.9 {POSIX open access modes: CREAT} {
  596.     exec echo xyzzy > test3
  597.     set f [open test3 {WRONLY CREAT}]
  598.     puts -nonewline $f "ab"
  599.     close $f
  600.     exec cat test3
  601. } abzzy
  602. test open-14.10 {POSIX open access modes: APPEND} {
  603.     exec echo xyzzy > test3
  604.     set f [open test3 {WRONLY APPEND}]
  605.     puts $f "new line"
  606.     seek $f 0
  607.     puts $f "abc"
  608.     close $f
  609.     exec cat test3
  610. } {xyzzy
  611. new line
  612. abc}
  613. test open-14.11 {POSIX open access modes: EXCL} {
  614.     exec echo xyzzy > test3
  615.     set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg]
  616.     regsub " already " $msg " " msg
  617.     string tolower $msg
  618. } {1 {couldn't open "test3": file exists}}
  619. test open-14.12 {POSIX open access modes: EXCL} {
  620.     catch {exec rm -f test3}
  621.     set x [catch {set f [open test3 {WRONLY CREAT EXCL}]}]
  622.     puts $f "A test line"
  623.     close $f
  624.     lappend x [exec cat test3]
  625. } {0 {A test line}}
  626. test open-14.13 {POSIX open access modes: TRUNC} {
  627.     exec echo xyzzy > test3
  628.     set f [open test3 {WRONLY TRUNC}]
  629.     puts $f abc
  630.     close $f
  631.     exec cat test3
  632. } {abc}
  633. if $atBerkeley {
  634.     test open-14.14 {POSIX open access modes: NOCTTY} {
  635.     catch {exec rm -f test3}
  636.     list [catch {open test3 {WRONLY NOCTTY CREAT}} msg] $msg
  637.     } {1 {access mode "NOCTTY" not supported by this system}}
  638.     test open-14.15 {POSIX open access modes: NONBLOCK} {
  639.     catch {exec rm -f test3}
  640.     set f [open test3 {WRONLY NONBLOCK CREAT}]
  641.     puts $f "NONBLOCK test"
  642.     close $f
  643.     exec cat test3
  644.     } {NONBLOCK test}
  645. }
  646. test open-14.16 {POSIX open access modes: errors} {
  647.     concat [catch {open test3 "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
  648. } "1 unmatched open brace in list
  649. unmatched open brace in list
  650.     while processing open access modes \"FOO {BAR BAZ\"
  651.     invoked from within
  652. \"open test3 \"FOO \\{BAR BAZ\"\""
  653. test open-14.17 {POSIX open access modes: errors} {
  654.     list [catch {open test3 {FOO BAR BAZ}} msg] $msg
  655. } {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}}
  656. test open-14.18 {POSIX open access modes: errors} {
  657.     list [catch {open test3 {TRUNC CREAT}} msg] $msg
  658. } {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
  659.  
  660. catch {exec rm -f test1 test2 test3}
  661. concat {}
  662.